/*
 * the "system" library - aka function which cannot be purely implemented in scheme.
 */

goto initRuntime;

#define TWO_INT_ARGS \
	RUNTIME_ASSERT (2==STACK_ARGC());\
	RUNTIME_ASSERT (sobIsInt (STACK_ARGV(0)));\
	RUNTIME_ASSERT (sobIsInt (STACK_ARGV(1)));

binary_int_eq:
FUNCTION_ENTER(binary_int_eq);
TWO_INT_ARGS
machine.reg[RES] = makeSchemeBool(SOB_INT_VALUE(STACK_ARGV(0)) ==
		SOB_INT_VALUE(STACK_ARGV(1)));
FUNCTION_EXIT( binary_int_eq);

binary_add:
FUNCTION_ENTER(binary_add);
TWO_INT_ARGS
machine.reg[RES] = makeSchemeInt(SOB_INT_VALUE(STACK_ARGV(0)) +
		SOB_INT_VALUE(STACK_ARGV(1)));

FUNCTION_EXIT( binary_add);

binary_div:
FUNCTION_ENTER(binary-div);
TWO_INT_ARGS
RUNTIME_ASSERT(SOB_INT_VALUE(STACK_ARGV(1)) != 0);
machine.reg[RES] = makeSchemeInt(SOB_INT_VALUE(STACK_ARGV(0)) /
		SOB_INT_VALUE(STACK_ARGV(1)));

FUNCTION_EXIT( binary_div);

binary_mul:
FUNCTION_ENTER(binary_mul);
TWO_INT_ARGS
machine.reg[RES] = makeSchemeInt(SOB_INT_VALUE(STACK_ARGV(0)) *
		SOB_INT_VALUE(STACK_ARGV(1)));
FUNCTION_EXIT( binary_mul);

binary_sub:
FUNCTION_ENTER(binary_sub);
TWO_INT_ARGS
machine.reg[RES] = makeSchemeInt(SOB_INT_VALUE(STACK_ARGV(0)) -
		SOB_INT_VALUE(STACK_ARGV(1)));
FUNCTION_EXIT( binary_sub);

car:
FUNCTION_ENTER(car);
RUNTIME_ASSERT(STACK_ARGC() == 1);
push(machine.reg[0]);
machine.reg[0] = STACK_ARGV(0);
RUNTIME_ASSERT(sobIsPair(machine.reg[0]));
machine.reg[RES] = SOB_PAIR_CAR(machine.reg[0]);
machine.reg[0] = pop();
FUNCTION_EXIT( car);

cdr:
FUNCTION_ENTER(cdr);
RUNTIME_ASSERT(STACK_ARGC() == 1);
push(machine.reg[0]);
machine.reg[0] = STACK_ARGV(0);
RUNTIME_ASSERT(sobIsPair(machine.reg[0]));
machine.reg[RES] = SOB_PAIR_CDR(machine.reg[0]);
machine.reg[0] = pop();
FUNCTION_EXIT( cdr);

cons:
FUNCTION_ENTER(cons);
RUNTIME_ASSERT(STACK_ARGC() == 2);
push(machine.reg[0]); /* car */
push(machine.reg[1]); /* cdr */
machine.reg[0] = STACK_ARGV(0);
machine.reg[1] = STACK_ARGV(1);
machine.reg[RES] = makeSchemePair(machine.reg[0], machine.reg[1]);
machine.reg[1] = pop();
machine.reg[0] = pop();
FUNCTION_EXIT( cons);

set_car:
FUNCTION_ENTER(set_car);
push(machine.reg[0]); /* pair */
push(machine.reg[1]); /* new car */
machine.reg[0] = STACK_ARGV(0);
machine.reg[1] = STACK_ARGV(1);
RUNTIME_ASSERT(sobIsPair(machine.reg[0]));
SOB_PAIR_CAR(machine.reg[0]) = machine.reg[1];
machine.reg[1] = pop();
machine.reg[0] = pop();
machine.reg[RES] = schemeVoid;
FUNCTION_EXIT( set_car);

set_cdr:
FUNCTION_ENTER(set_cdr);
push(machine.reg[0]); /* pair */
push(machine.reg[1]); /* new cdr */
machine.reg[0] = STACK_ARGV(0);
machine.reg[1] = STACK_ARGV(1);
RUNTIME_ASSERT(sobIsPair(machine.reg[0]));
SOB_PAIR_CDR(machine.reg[0]) = machine.reg[1];
machine.reg[1] = pop();
machine.reg[0] = pop();
machine.reg[RES] = schemeVoid;
FUNCTION_EXIT( set_cdr);

binaryLessThan:
FUNCTION_ENTER(binaryLessThan);
RUNTIME_ASSERT(STACK_ARGC() == 2);
push(machine.reg[0]);
push(machine.reg[1]);
machine.reg[0] = STACK_ARGV(0);
machine.reg[1] = STACK_ARGV(1);
RUNTIME_ASSERT(sobIsInt(machine.reg[0]));
RUNTIME_ASSERT(sobIsInt(machine.reg[1]));
if (SOB_INT_VALUE(machine.reg[0]) >= SOB_INT_VALUE(machine.reg[1])) goto scheme_binaryLessThen_else;
machine.reg[RES] = schemeTrue;
goto scheme_binaryLessThen_exit;
scheme_binaryLessThen_else:
machine.reg[RES] = schemeFalse;
scheme_binaryLessThen_exit:
machine.reg[1] = pop();
machine.reg[0] = pop();
FUNCTION_EXIT( binaryLessThan);

eq:
FUNCTION_ENTER(eq);
RUNTIME_ASSERT(STACK_ARGC() == 2);
push(machine.reg[0]);
push(machine.reg[1]);
machine.reg[0] = STACK_ARGV(0);
machine.reg[1] = STACK_ARGV(1);
if (!sobIsSymbol(machine.reg[0])) goto scheme_eq_regularCompare;
if (!sobIsSymbol(machine.reg[1])) goto scheme_eq_regularCompare;
/* both args are symbols */
machine.reg[RES] = makeSchemeBool(SOB_SYMBOL_ENTRY(machine.reg[0]) == SOB_SYMBOL_ENTRY(machine.reg[1]));
goto scheme_eq_exit;
scheme_eq_regularCompare: /* at least one arg is not a symbol */
machine.reg[RES] = makeSchemeBool(SOB_DATA(machine.reg[0]) == SOB_DATA(machine.reg[1]));
scheme_eq_exit:
machine.reg[1] = pop();
machine.reg[0] = pop();
FUNCTION_EXIT( eq);

isboolean:
FUNCTION_ENTER(isboolean);
RUNTIME_ASSERT(STACK_ARGC() == 1);
machine.reg[RES] = makeSchemeBool(sobIsBool(STACK_ARGV(0)));
FUNCTION_EXIT( isboolean);

isnumber:
FUNCTION_ENTER(isnumber);
RUNTIME_ASSERT(STACK_ARGC() == 1);
machine.reg[RES] = makeSchemeBool(sobIsInt(STACK_ARGV(0)));
FUNCTION_EXIT( isnumber);

isprocedure:
FUNCTION_ENTER(isprocedure);
RUNTIME_ASSERT(STACK_ARGC() == 1);
machine.reg[RES] = makeSchemeBool(sobIsClosure(STACK_ARGV(0)));
FUNCTION_EXIT( isprocedure);

isstring:
FUNCTION_ENTER(isstring);
RUNTIME_ASSERT(STACK_ARGC() == 1);
machine.reg[RES] = makeSchemeBool(sobIsString(STACK_ARGV(0)));
FUNCTION_EXIT( isstring);

ischar:
FUNCTION_ENTER(ischar);
RUNTIME_ASSERT(STACK_ARGC() == 1);
machine.reg[RES] = makeSchemeBool(sobIsChar(STACK_ARGV(0)));
FUNCTION_EXIT( ischar);

ispair:
FUNCTION_ENTER(ispair);
RUNTIME_ASSERT(STACK_ARGC() == 1);
machine.reg[RES] = makeSchemeBool(sobIsPair(STACK_ARGV(0)));
FUNCTION_EXIT( ispair);

issymbol:
FUNCTION_ENTER(issymbol);
RUNTIME_ASSERT(STACK_ARGC() == 1);
machine.reg[RES] = makeSchemeBool(sobIsSymbol(STACK_ARGV(0)));
FUNCTION_EXIT( issymbol);

isvector:
FUNCTION_ENTER(isvector);
RUNTIME_ASSERT(STACK_ARGC() == 1);
machine.reg[RES] = makeSchemeBool(sobIsVector(STACK_ARGV(0)));
FUNCTION_EXIT( isvector);

isnull:
FUNCTION_ENTER(isnull);
RUNTIME_ASSERT(STACK_ARGC() == 1);
machine.reg[RES] = makeSchemeBool(sobIsVoid(STACK_ARGV(0)));
FUNCTION_EXIT( isnull);

make_string:
FUNCTION_ENTER(make_string);
RUNTIME_ASSERT(STACK_ARGC() <= 2);
push(machine.reg[0]);
RUNTIME_ASSERT (sobIsInt (STACK_ARGV(0)));
if (STACK_ARGC() == 2) goto make_string_argc_2;
machine.reg[0] = (void*)' ';//default character if fill char is unspecified
goto make_string_argc_end_if;
make_string_argc_2:
RUNTIME_ASSERT (sobIsChar (STACK_ARGV(1)));
machine.reg[0] = (void*)(long)SOB_CHAR_VALUE(STACK_ARGV(1));
make_string_argc_end_if:
machine.reg[RES] = makeSchemeStringFromScratch ( SOB_INT_VALUE(STACK_ARGV(0)),(char)(long)machine.reg[0]);
machine.reg[0] = pop();
FUNCTION_EXIT( make_string);

string_length:
FUNCTION_ENTER(string_length);
RUNTIME_ASSERT(STACK_ARGC() == 1);
RUNTIME_ASSERT (sobIsString (STACK_ARGV(0)));
machine.reg[RES] = makeSchemeInt (SOB_STRING_LENGTH (STACK_ARGV(0)));
FUNCTION_EXIT( string_length);

string_ref:
FUNCTION_ENTER(string_ref);
RUNTIME_ASSERT(STACK_ARGC() == 2);
RUNTIME_ASSERT (sobIsString (STACK_ARGV(0)));//making sure there's a string
RUNTIME_ASSERT (sobIsInt (STACK_ARGV(1))); //index in the string is int
RUNTIME_ASSERT ( SOB_INT_VALUE (STACK_ARGV(1)) < SOB_STRING_LENGTH (STACK_ARGV(0)) );//making sure k is within the string
machine.reg[RES] = makeSchemeChar ((char)SOB_STRING_REF(STACK_ARGV(0),SOB_INT_VALUE(STACK_ARGV(1))));
FUNCTION_EXIT( string_ref);

string_set:
FUNCTION_ENTER(string_set);
RUNTIME_ASSERT(STACK_ARGC() == 3);
RUNTIME_ASSERT (sobIsString (STACK_ARGV(0)));//making sure there's a string
RUNTIME_ASSERT (sobIsInt (STACK_ARGV(1))); //index in the string is int
RUNTIME_ASSERT (SOB_INT_VALUE (STACK_ARGV(1)) < SOB_STRING_LENGTH (STACK_ARGV(0)));//making sure k is within the string
RUNTIME_ASSERT (sobIsChar (STACK_ARGV(2)));
SOB_STRING_SET(STACK_ARGV(0), SOB_INT_VALUE(STACK_ARGV(1)), SOB_CHAR_VALUE(STACK_ARGV(2)));
machine.reg[RES] = schemeVoid;
FUNCTION_EXIT( string_set);

string_to_symbol:
FUNCTION_ENTER(string_to_symbol);
RUNTIME_ASSERT(STACK_ARGC() == 1);
RUNTIME_ASSERT (sobIsString (STACK_ARGV(0)));
machine.reg[RES] = makeSchemeSymbol(SOB_STRING_VALUE(STACK_ARGV(0)));
FUNCTION_EXIT( string_to_symbol);

symbol_to_string:
FUNCTION_ENTER(symbol_to_string);
RUNTIME_ASSERT(STACK_ARGC() == 1);
RUNTIME_ASSERT (sobIsSymbol (STACK_ARGV(0)));
machine.reg[RES] = makeSchemeString(SOB_SYMBOL_NAME(STACK_ARGV(0)));
FUNCTION_EXIT( symbol_to_string);

apply_func:
FUNCTION_ENTER(apply_func);
RUNTIME_ASSERT(STACK_ARGC() == 2);
RUNTIME_ASSERT(sobIsClosure(STACK_ARGV(0)));
push(machine.reg[0]); /* env / loop counter */
push(machine.reg[1]); /* code / list iterator */
/* asserting of the args is in SchemeListLength */
machine.reg[RES] = (void*)SchemeListLength(STACK_ARGV(1));
/* we have machine.reg[RES] == n arguments. we are going to reverse-push them by
 pushing the head to stack[sp+n-1], head->next will go to stack[sp+n-2]... and so
 on until stack[sp+0]. */
machine.reg[1] = STACK_ARGV(1);
machine.reg[0] = machine.reg[RES];
apply_func_loop_start:
if (sobIsNil(machine.reg[1])) goto apply_func_loop_end;
machine.reg[0] = (void*)((Amount)machine.reg[0] - 1);
machine.stack[machine.sp + (Amount)machine.reg[0]] = SOB_PAIR_CAR(machine.reg[1]);
machine.reg[1] = SOB_PAIR_CDR(machine.reg[1]);
goto apply_func_loop_start;
apply_func_loop_end:
DEBUG_ASSERT((Amount)machine.reg[0] == 0);
machine.sp += (Amount)machine.reg[RES]; /* fix sp */
machine.reg[1] = SOB_CLOSURE_ENV(STACK_ARGV(0));
machine.reg[0] = SOB_CLOSURE_CODE(STACK_ARGV(0));
CALL(*machine.reg[0], (Amount)machine.reg[RES], machine.reg[1], &&exit_apply_func);
exit_apply_func:
machine.reg[1] = pop();
machine.reg[0] = pop();
FUNCTION_EXIT( apply_func);

charToInt:
FUNCTION_ENTER(charToInt);
RUNTIME_ASSERT(STACK_ARGC() == 1);
RUNTIME_ASSERT(sobIsChar(STACK_ARGV(0)));
machine.reg[RES] = (void*)(long)SOB_CHAR_VALUE(STACK_ARGV(0));
machine.reg[RES] = makeSchemeInt((int)machine.reg[RES]);
FUNCTION_EXIT( charToInt);

intToChar:
FUNCTION_ENTER(intToChar);
RUNTIME_ASSERT(STACK_ARGC() == 1);
RUNTIME_ASSERT(sobIsInt(STACK_ARGV(0)));
machine.reg[RES] = (void*)SOB_INT_VALUE(STACK_ARGV(0));
machine.reg[RES] = makeSchemeChar((char)(long)machine.reg[RES]);
FUNCTION_EXIT( intToChar);

makeVector:
FUNCTION_ENTER(makeVector);
RUNTIME_ASSERT(STACK_ARGC() >= 1);
RUNTIME_ASSERT(STACK_ARGC() <= 2);
RUNTIME_ASSERT(sobIsInt(STACK_ARGV(0)));
RUNTIME_ASSERT(SOB_INT_VALUE(STACK_ARGV(0))>=0);
machine.reg[RES] = schemeVoid;
if (STACK_ARGC() != 2) goto makeVector_create;
//machine.reg[RES] = STACK_ARGV(1) ; /* singleton of the initial element */
//machine.reg[RES] = SOB_PAIR_CAR(machine.reg[RES]) ; /* the actual init value */
machine.reg[RES] = STACK_ARGV(2);
makeVector_create:
machine.reg[RES] = makeSchemeVector((int)SOB_INT_VALUE(STACK_ARGV(0)),machine.reg[RES]);
FUNCTION_EXIT( makeVector);

vectorLength:
FUNCTION_ENTER(vectorLength);
RUNTIME_ASSERT(STACK_ARGC() == 1);
RUNTIME_ASSERT(sobIsVector(STACK_ARGV(0)));
machine.reg[RES]=makeSchemeInt(SOB_VECTOR_LENGTH(STACK_ARGV(0)));
FUNCTION_EXIT( vectorLength);

vectorSet:
FUNCTION_ENTER(vectorSet);
RUNTIME_ASSERT(STACK_ARGC() == 3);
RUNTIME_ASSERT(sobIsVector(STACK_ARGV(0)));
RUNTIME_ASSERT(sobIsInt(STACK_ARGV(1)));
RUNTIME_ASSERT(SOB_INT_VALUE(STACK_ARGV(1))>=0);
RUNTIME_ASSERT(SOB_VECTOR_LENGTH(STACK_ARGV(0))>SOB_INT_VALUE(STACK_ARGV(1)));
push(machine.reg[0]);//pointer to vector
push(machine.reg[1]);//place to change
push(machine.reg[2]);//change
machine.reg[0] = STACK_ARGV(0);
machine.reg[1] = STACK_ARGV(1);
machine.reg[2] = STACK_ARGV(2);
SOB_VECTOR_SET(machine.reg[0], SOB_INT_VALUE(machine.reg[1]),machine.reg[2]);
machine.reg[2] = pop();
machine.reg[1] = pop();
machine.reg[0] = pop();
machine.reg[RES] = schemeVoid;
FUNCTION_EXIT( vectorSet);

vectorRef:
FUNCTION_ENTER(vectorRef);
RUNTIME_ASSERT(STACK_ARGC() == 2);
RUNTIME_ASSERT(sobIsInt(STACK_ARGV(1)));
RUNTIME_ASSERT(sobIsVector (STACK_ARGV(0)));
RUNTIME_ASSERT(SOB_INT_VALUE(STACK_ARGV(1))>=0);
RUNTIME_ASSERT(SOB_VECTOR_LENGTH(STACK_ARGV(0))>SOB_INT_VALUE(STACK_ARGV(1)));
push(machine.reg[0]);
push(machine.reg[1]);
machine.reg[0] = STACK_ARGV(0);
machine.reg[1] = STACK_ARGV(1);
machine.reg[RES]=(SOB_VECTOR_REF(machine.reg[0],SOB_INT_VALUE(machine.reg[1])));
machine.reg[1] = pop();
machine.reg[0] = pop();
FUNCTION_EXIT( vectorRef);

initRuntime:
DEBUG_ENTER("init runtime");
/* base binary function to become variadic by support code that was written in scheme */
bindToGlobalEnv("binary-add", &&binary_add);
bindToGlobalEnv("binary-divide", &&binary_div);
bindToGlobalEnv("binary-multiply", &&binary_mul);
bindToGlobalEnv("binary-subtract", &&binary_sub);
bindToGlobalEnv("binary-div", &&binary_div);
bindToGlobalEnv("binary-mul", &&binary_mul);
bindToGlobalEnv("binary-sub", &&binary_sub);
bindToGlobalEnv("binary=?", &&binary_int_eq);
bindToGlobalEnv("binary<?", &&binaryLessThan);
/* general */
bindToGlobalEnv("eq?", &&eq);
bindToGlobalEnv("apply", &&apply_func);
/* pair */
bindToGlobalEnv("car", &&car);
bindToGlobalEnv("cdr", &&cdr);
bindToGlobalEnv("set-car!", &&set_car);
bindToGlobalEnv("set-cdr!", &&set_cdr);
bindToGlobalEnv("cons", &&cons);
bindToGlobalEnv("pair?",&&ispair);
/* number */
bindToGlobalEnv("integer?",&&isnumber);
bindToGlobalEnv("binary<", &&binaryLessThan);
/* bool */
bindToGlobalEnv("boolean?",&&isboolean);
/* closure */
bindToGlobalEnv("procedure?",&&isprocedure);
/* char */
bindToGlobalEnv("char?",&&ischar);
bindToGlobalEnv("integer->char",&&intToChar);
bindToGlobalEnv("char->integer",&&charToInt);
/* symbol */
bindToGlobalEnv("symbol?",&&issymbol);
/* vector */
bindToGlobalEnv("vector?",&&isvector);
/* string */
bindToGlobalEnv("make-string",&&make_string);
bindToGlobalEnv("string-length",&&string_length);
bindToGlobalEnv("string-ref",&&string_ref);
bindToGlobalEnv("string-set!",&&string_set);
bindToGlobalEnv("string?",&&isstring);
bindToGlobalEnv("string->symbol",&&string_to_symbol);
bindToGlobalEnv("symbol->string",&&symbol_to_string);
/* vector */
bindToGlobalEnv("vector?",&&isvector);
bindToGlobalEnv("vector-set!", &&vectorSet);
bindToGlobalEnv("vector-ref", &&vectorRef);
bindToGlobalEnv("vector-length", &&vectorLength);
bindToGlobalEnv("make-vector", &&makeVector);

DEBUG_EXIT("init runtime");

